Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE12/CONSTRUC/TBHEXVU.PAS

Pascal/Delphi Source File | 1996-07-17 | 5.6 KB | 199 lines

unit TBHEXVU;
{$I+}
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;

Const
  BlockLine = 16;
  BlockChar = 16;
  BlockSize = BlockLine * BlockChar; { 16 x 16 = 256 }

Type
  TBlock = Array[1..BlockSize] of Byte;

  TBHexViewer = class(TStringGrid)
    private
      { Private declarations }
      FFileName: TFileName;
      procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    protected
      { Protected declarations }
      FFile: File;
      FOffset: LongInt; { 0, 256, 512, ... 2G }
      FBlock: TBlock; { data from FFile }
      FSize: Cardinal; { actual size of data in FBlock }
      FAbout: String;
      procedure SetFileName(AFileName: TFileName); virtual;
      procedure SetOffset(AnOffset: LongInt); virtual;
      procedure SetSize(unused: Cardinal); { do nothing }
      procedure SetAbout(unused: String); { do nothing }
      function SelectCell(ACol, ARow: Longint): Boolean; override;
      { this function does *not* work when declared private... }
    public
      { Public declarations }
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
    published
      { Published declarations }
      property FileName: TFileName read FFileName write SetFileName;
      property Offset: LongInt read FOffset write SetOffset default 0;
      property Size: Cardinal read FSize write SetSize default 0;
      property About: String read FAbout write SetAbout;
    end {TBHexViewer};

implementation

  constructor TBHexViewer.Create(AOwner: TComponent);
  var i: Integer;
  begin
    inherited Create(AOwner);
    FAbout := 'TBHexViewer (c) 1996 by Dr.Bob [100434,2072]-> see http://www.pi.net/~drbob/';
    ParentFont := False;
    Font.Name := 'Courier New';
    Font.Size := 10;
    Height := 342{+17};
    Width := 632;
    FFileName := '';
    FOffset := 0;
    FSize := 0;
    ScrollBars := ssNone;
    ColCount := 18;
    RowCount := 17;
    DefaultRowHeight := 19{+1};
    Cells[$0,0] := 'offset';
    Cells[$1,0] := '$1';
    Cells[$2,0] := '$2';
    Cells[$3,0] := '$3';
    Cells[$4,0] := '$4';
    Cells[$5,0] := '$5';
    Cells[$6,0] := '$6';
    Cells[$7,0] := '$7';
    Cells[$8,0] := '$8';
    Cells[$9,0] := '$9';
    Cells[$A,0] := '$A';
    Cells[$B,0] := '$B';
    Cells[$C,0] := '$C';
    Cells[$D,0] := '$D';
    Cells[$E,0] := '$E';
    Cells[$F,0] := '$F';
    Cells[16,0] := '$0';
    ColWidths[0] := 76;
    for i:=1 to 16 do ColWidths[i] := 25;
    ColWidths[17] := 136
  end {Create};

  destructor TBHexViewer.Destroy;
  begin
    if FFileName <> '' then
    begin
      {$I-}
      Close(FFile);
      {$I+}
      if IOResult <> 0 then { skip };
    end;
    inherited Destroy
  end {Destroy};

  procedure TBHexViewer.SetFileName(AFileName: TFileName);
  begin
    if FFileName <> '' then
    begin
      FFileName := '';
      FOffset := 0;
      FSize := 0;
      {$I-}
      System.Close(FFile);
      {$I+}
      if IOResult <> 0 then { skip };
    end;
    System.Assign(FFile,AFileName);
    try
      FileMode := $42; { read/write, deny-none }
      System.Reset(FFile,1);
      FFileName := AFileName { success! }
    except
      FFileName := ''
    end;
    Offset := 0
  end {SetFileName};

  procedure TBHexViewer.SetOffset(AnOffset: LongInt);
  var i,j,k: Integer;
      Line: String;
  begin
    AnOffset := AnOffset AND NOT BlockLine; { skip lower bits }
    if (AnOffset <> FOffset) or (AnOffset = 0) or (FOffset = 0) then
    begin
      FOffset := AnOffset;
      FillChar(FBlock,SizeOf(FBlock),#0);
      try
        if FFileName <> '' then
        try
          Seek(FFile,FOffset);
          BlockRead(FFile,FBlock,SizeOf(FBlock),FSize);
        except
          FOffset := 0;
          FSize := 0
        end
        else
        begin
          FOffset := 0;
          FSize := 0
        end;
      finally
        k := 0;
        for i:=1 to BlockLine do
        begin
          Cells[0,i] := '$'+IntToHex(FOffset + Pred(i) * BlockChar,8);
          for j:=1 to BlockChar do
          begin
            Inc(k);
            if k <= FSize then Cells[j,i] := IntToHex(FBlock[k],2)
                          else Cells[j,i] := ''
          end;
          Dec(k,BlockChar);
          Line := '';
          for j:=1 to BlockChar do
          begin
            Inc(k);
            if k <= FSize then if FBlock[k] < 32 then Line := Line + ' '
                                                 else Line := Line + Chr(FBlock[k])
          end;
          Cells[17,i] := Line
        end
      end
    end
  end {SetOffset};

  procedure TBHexViewer.SetSize(unused: Cardinal);
  begin
    { does nothing, but makes the Size property visible in the Object Inspector }
  end {SetSize};

  procedure TBHexViewer.SetAbout(unused: String);
  begin
    { does nothing, but makes the About property visible in the Object Inspector }
  end {SetAbout};

  function TBHexViewer.SelectCell(ACol, ARow: Longint): Boolean;
  begin
    Result := inherited SelectCell(ACol,ARow) and (ACol <> 17)
  end {SelectCell};

  procedure TBHexViewer.KeyDown(var Key: Word; Shift: TShiftState);
  begin
    if Key = 34 then { PgDown }
    begin
      if Size = BlockSize then Offset := Offset + BlockSize
    end
    else if Key = 33 then { PgUp }
    begin
      if (Offset >= BlockSize) then Offset := Offset - BlockSize
                               else Offset := 0
    end;
    inherited KeyDown(Key,Shift);
  end {KeyDown};
end.